home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-13
/
emac16ds.zip
/
MINTPRIM.ASM
< prev
next >
Wrap
Assembly Source File
|
1992-08-01
|
36KB
|
1,576 lines
;History:1261,1
;Thu Mar 26 21:42:34 1992 Improve ct so that it returns file size and attribute info.
;Wed Aug 14 23:02:57 1991 Add env.SCREEN to the list of strings created by #(ev).
;Sun Jun 16 23:52:43 1991 Change #(mp) so that it preserves the "no sgaps marker" if no matches were found.
;Mon May 06 00:53:33 1991 experiment with sgap markers.
;Sun May 05 19:42:10 1991 add #(hk,...)
;Sat May 04 22:31:00 1991 added #(!=)
;Mon Apr 16 22:41:11 1990 Add "Read Only" error to write_error.
;Thu Feb 22 23:32:17 1990 add logical operators: and, or, xor.
;Tue Feb 13 19:24:24 1990 add 'Read Only' to the list of read_errors.
;Thu Sep 14 23:38:27 1989 when dealing with nonexistent strings, remember whether it was active or not.
;Tue Sep 12 23:52:46 1989 gs_prim now calls dflt if the real string can't be found.
;Sun Jun 25 23:55:33 1989 try a faster string_search
;11-04-88 00:39:35 remove #(dt) and #(tm) and put in #(ct).
;10-24-88 23:08:30 change #(si) so that it maps multiple characters.
;10-01-88 17:31:20 get_number would look too far for a minus sign.
;09-18-88 23:13:15 add "string index", si_prim.
;05-15-88 20:04:09 Remove reference to non-existent buffer_free1 [kdb]
;04-19-88 23:01:23 in ll_prim, protect the data buffer by setting data_topbot.
;04-19-88 20:16:30 ll_prim didn't work with a shortage of memory.
;03-27-88 13:40:14 change getarg_filename so that it returns zr on empty filenames.
;03-14-88 23:26:08 add fullpath under dos 3.0.
;12-07-87 23:14:20 make mp_prim discard sgaps after making parameters.
;11-10-87 21:43:34 make a marker at the end of the bufseg() definition.
;09-06-87 23:27:39 in ll_prim, we're all done if we hit eof.
;09-06-87 23:07:39 use a big buffer to read libraries in.
;07-10-87 00:13:50 get rid of duplicate copy of bc_prim.
page ,132
.xlist
include emacs.def
include mintform.def
include mint.def
include findfile.def
include memory.def
data segment byte public
extrn data_bottop: word
extrn data_topbot: word
extrn fbgn: word
extrn fend: word
extrn filename: byte, filename2: byte
size_buf dw ?
public save_stack
save_stack dw ?
public read_errors
read_errors dw read_error_1
dw read_error_2
dw read_error_3
dw read_error_4
dw read_error_5
dw read_error_6
public write_errors
write_errors dw write_error_1
dw write_error_2
dw write_error_3
dw write_error_4
dw write_error_5
read_error_1 label byte
read_error_2 db 'File too large'
read_error_3 db 'File not found'
read_error_4 db 'End of file'
read_error_5 db 'Read Only'
read_error_6 label byte
write_error_1 label byte
write_error_2 db 'Disk full'
write_error_3 db 'Directory full or bad filename'
write_error_4 db 'Read Only'
write_error_5 label byte
runline_name label byte
environ_name db 'env.'
environ_name_len equ $-environ_name
db 'RUNLINE'
runline_len equ $-environ_name
switchar_name db 'env.SWITCHAR'
switchar_len equ $-switchar_name
fullpath_name db 'env.FULLPATH'
fullpath_len equ $-fullpath_name
screen_name db 'env.SCREEN'
screen_len equ $-screen_name
dflta_name db 'dflta'
dflta_len equ $-dflta_name
dfltn_name db 'dfltn'
dfltn_len equ $-dfltn_name
form_prefix_len dw ? ;for use by ln prim
form_prefix_ptr dw ? ;...
out_of_memory_msg db 'Not enough memory.$'
break_state db ? ;=state of break checking flag.
extrn stackp: byte
extrn max_screen_line: byte
public phd_seg
phd_seg dw ?
day_of_week db 'Sun Mon Tue Wed Thu Fri Sat '
months db 'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec '
data ends
code segment byte public
assume cs:code, ds:data, es:data
extrn buffer_free: near
;starting address of program.
init:
mov ax,data
mov ds,ax
mov bx,es:[2] ;get available paragraphs.
mov phd_seg,es
mov es,ax
cli
mov ss,ax
mov sp,offset stackp
sti
mov dx,bx
sub dx,ax ;compute memory between data and end.
cmp dx,1000h ;more than 64k?
jb init_exit ;no - not enough memory.
add ax,1000h ;start buffers at the next segment up.
;enter with ax=>first paragraph of available memory, bx=> first paragraph of
; unavailable memory.
push ax
push bx
call init_entry ;init the machine-dependent code
pop bx
pop ax
call init_all_buffers
jc init_exit_uninit ;no memory.
call init_screen ;initialize redisplay.
call pick_init ;initialize the mouse.
push ds ;set the fatal error address.
push cs
pop ds
mov dx,offset abort_fatal
mov ax,2524h
int 21h
pop ds
mov ax,33h*256+0 ;get the break state.
int 21h
mov break_state,dl
mov ax,33h*256+1 ;turn break checking off.
mov dl,0
int 21h
jmp init_ids_first
init_exit_uninit:
call uninit_exit
init_exit:
mov dx,offset out_of_memory_msg
mov ah,9
int 21h
mov ax,4c01h
int 21h ;halt because of no memory.
;the following externs are in 'buffers'
extrn init_all_buffers: near
;the following externs are in 'redisp'
extrn init_screen: near
;the following externs are in 'pick'
extrn pick_init: near
extrn init_ids_first: near ;start mint interpreter
extrn init_ids: near ;restart mint interpreter
extrn abort_fatal: near ;fatal error handler
extrn read_chars: near ;read chars off the original screen.
;the following externs are in 'mintprim'
extrn init_forms: near
;The following two externs init and uninit anything that's machine specific.
extrn init_entry: near
extrn uninit_exit: near
extrn return_form: near
;return_form updates the form pointer and jumps to return_tos.
;Enter with ds:bx ->form, cx=unused chars.
extrn return_null: near
extrn make_active: near
;make_active forces the function to be executed in active mode, and returns
; zr if the function already was active.
extrn return_arg: near
;return_arg returns the argument whose number is given in cx.
extrn return_arg_active: near
;return_arg_active returns the argument whose number is given in cx, and makes
; it active.
extrn return_string: near
;return_string returns the ALth string out of the table pointed to by bx.
extrn return_sicx: near
;return_sicx returns the string pointed to by si. The length of the
; string is given in cx.
extrn return_tos: near
;return_tos returns the string pointed to by the top of the stack.
; The length of the string is the difference between di and the
; beginning of the stirng.
extrn nomem: near
;primitives here
hl_prim:
call get_decimal_arg1 ;get the return code.
push ax
mov ax,33h*256+1 ;set the break state.
mov dl,break_state
int 21h
call uninit_exit
pop ax
mov ah,4ch
int 21h
eq_prim:
call getarg1 ;get the first argument
mov dx,cx ;save size of first argument
mov di,si ;save pointer to first argument
mov cx,2 ;get second argument
call getarg
cmp cx,dx ;lengths equal?
jne eq_prim_1 ;no, return 4th
repe cmpsb ;strings equal?
jne eq_prim_1 ;no, return 4th.
mov cx,3
jmp return_arg
eq_prim_1:
mov cx,4
jmp return_arg
ne_prim:
call getarg1 ;get the first argument
mov dx,cx ;save size of first argument
mov di,si ;save pointer to first argument
mov cx,2 ;get second argument
call getarg
cmp cx,dx ;lengths equal?
jne ne_prim_1 ;no, return 3rd
repe cmpsb ;strings equal?
jne ne_prim_1 ;no, return 3rd.
mov cx,4
jmp return_arg
ne_prim_1:
mov cx,3
jmp return_arg
nc_prim:
call getarg1
di_points_fbgn
mov ax,cx
jmp return_number
db_prim:
int 3
jmp return_null
ct_prim:
;Mon Nov 21 11:31:54 1983
call getarg1_filename ;get the filename.
jz ct_prim_1
mov dx,offset filename2
mov ah,1ah
int 21h
mov dx,si ;filename in dx for find_first.
mov ah,4eh ;find first matching file
mov cx,10h ;find subdirs, too.
int 21h
jnc ct_prim_3 ;go if we found it.
jmp return_null
ct_prim_1:
mov ah,2ch ;get hhmm into si, ssxx into bp, ddd into al.
int 21h
mov si,cx
mov bp,dx
mov ah,2ah ;get mmdd into dx, yyyy into cx.
int 21h
di_points_fbgn
call put_ct
jmp return_tos
ct_prim_3:
di_points_fbgn
mov cx,2
call getarg
push cx ; save arg2
jcxz ct_prim_6 ; if no attributes
;put attributes ADLSHR
mov al,filename2.find_buf_attr
and al,37h ;only interesting attributes
mov ah,0
mov bx,2 ;binary
mov cx,6
call put_number
ct_prim_6:
;put C time of file modified
mov ax,filename2.find_buf_time ;get the hours
mov cl,3
shr ax,cl
xor al,al
mov si,ax
mov ax,filename2.find_buf_time ;get the minutes
mov cl,5
shr ax,cl
and al,3fh
xor ah,ah
or si,ax
mov ax,filename2.find_buf_time ;get the seconds.
mov ah,al
xor al,al
and ah,1fh
shl ah,1 ;but they're twoseconds.
mov bp,ax
;we have hhmm in si, ssxx in bp, ddd in al.
mov ax,filename2.find_buf_date ;get the months
mov cl,3
shl ax,cl
and ax,0f00h
mov dx,ax
mov ax,filename2.find_buf_date ;get the days
and ax,1fh
or dx,ax
mov ax,filename2.find_buf_date ;get the year.
shr ah,1
mov al,ah
xor ah,ah
add ax,1980
mov cx,ax
mov al,7 ;use ' ' as the day of the week.
;we have mmdd in dx, yyyy in cx.
call put_ct
pop cx ; get arg2
jcxz ct_prim_4 ; if no file size
mov al,' '
stosb
;and last, put the file size
mov ax,word ptr filename2.find_buf_size
mov dx,word ptr filename2.find_buf_size+2
cmp dx,10000
jae ct_prim_4 ;null if too big (655350000 bytes)
mov cx,10000
div cx
mov bx,10 ;old base ten for this
or ax,ax ;short file?
jz ct_prim_5
push dx
mov cx,0
call put_number
pop ax
mov cx,4
call put_number
ct_prim_4:
jmp return_tos
ct_prim_5:
mov ax,dx
mov cx,0
call put_number
jmp return_tos
put_ct:
;we have hhmm in si, ssxx in bp, ddd in al.
;we have mmdd in dx, yyyy in cx. And di_points_fbgn
push cx ;squirrel yyyy, ssxx, and hhmm away.
push bp
push si
;we have mmdd in dx, ddd in al.
xor ah,ah ;stuff the day of the week.
add al,al
add al,al
mov si,offset day_of_week
add si,ax
movsw
movsw
mov al,dh ;get month (1..12)
dec al
xor ah,ah ;stuff the month
add al,al
add al,al
mov si,offset months
add si,ax
movsw
movsw
mov al,dl ;pushed as dx (get date)
mov bx,10 ;do all conversions in decimal.
mov ah,0
mov cx,2
call put_number
mov al,' '
stosb
pop bp ;pushed as cx (get minutes)
mov ax,bp ;we need them in a two-byte register.
mov al,ah ;get hours
mov ah,0
mov cx,2
call put_number
mov al,":"
stosb
mov ax,bp ;get minutes back.
mov ah,0
mov cx,2
call put_number
mov al,":"
stosb
pop dx ;get seconds
mov al,dh
mov ah,0
mov cx,2
call put_number
mov al,' '
stosb
pop ax ;get the year.
mov cx,4
call put_number
ret
;form primitives
ds_prim:
mov cx,2 ;get data first.
call getarg
mov dx,cx
or dx,8000h ;set the no-sgap marker.
mov di,si
call getarg1
mov bx,0 ;reset form pointer.
call define_form
jmp return_null
mp_prim:
call getarg1
call find_form
jc mp_prim_2
assume es:formSeg
mov dx,formSeg:[bx].data_length ;save the count of the form in dx.
mov bp,dx
and bp,8000h ;remember the sgap marker.
and dx,7fffh ;get rid of sgap marker.
lea di,formSeg:[bx].name_offset
add di,formSeg:[bx].name_length ;save the pointer to the form in di.
mov si,fbgn ;point si at the zeroth arg.
mov si,data:[si] ;point si at the form name.
mov si,data:[si] ;point si at the first argument.
mov ah,sgap+1 ;start with sgap 1.
mp_prim_1:
cmp si,data:[si] ;are we pointing at fend?
je mp_prim_3
push si ;save pointer to args.
mov cx,data:[si] ;compute length of this arg.
sub cx,si
sub cx,mark_overhead
add si,mark_overhead-1 ;make si=> text of argument.
;at this point, si,cx => arg; di,dx => form.
push di
push dx
jcxz mp_prim_5 ;ignore null strings.
mp_prim_4:
call string_search
jc mp_prim_5 ;not found. Done with this arg.
;at this point, we have found a string. We proceed to replace it by
;the appropriate segment gap. We have already ensured that the string
;is at least one character long.
push cx ;preserve cx
mov al,ah ;get the sgap.
stosb ;store it.
;by the way, at this point, the relation (cx <= dx) is always true.
sub dx,cx ;count it, and the ones we're getting rid of.
dec cx ;one less to get rid of.
mov al,sgap ;get rid of the rest of the chars.
rep stosb ;cx may be zero, but it doesn't hurt.
pop cx
xor bp,bp ;clear sgap marker -- we found one.
jmp mp_prim_4
mp_prim_5:
pop dx
pop di
pop si ;restore pointer to args.
mov si,[si] ;make it point to next arg.
inc ah ;increment sgap to next arg.
jmp mp_prim_1
mp_prim_3:
cmp bp,0 ;should we nuke sgaps (were any matches found?)
jne mp_prim_9 ;no matches found, preserve sgaps, don't change len.
mov si,di ;now prepare to crunch out the sgap's.
mov cx,dx
mov dx,di
jcxz mp_prim_8
mp_prim_6:
lods es:byte ptr 0 ;get a byte from es:
cmp al,sgap ;discard sgaps.
je mp_prim_7
stosb
mp_prim_7:
loop mp_prim_6
mp_prim_8:
sub di,dx ;subtract off the base of the string.
or di,bp ;if no match found, preserve original sgap marker.
mov formSeg:[bx].data_length,di
mp_prim_9:
esdata
mp_prim_2:
jmp return_null
nb_prim:
call find_arg1
dsdata
mov cx,3
jc nb_prim_1
mov cx,2
nb_prim_1:
jmp return_arg
assume ds:data, es:data
si_prim:
mov cx,2 ;get the character we're translating.
call getarg
mov di,si ;we need it in di.
push di ;save this as the pointer to what we return.
jcxz si_prim_1 ;if no characters, return null.
push di ;remember arg2.
push cx
call find_arg1
mov dx,cx
pop cx
pop di
jc si_prim_1 ;go if it doesn't exist.
mov bx,si ;we need the pointer to the string
xor ah,ah ; in bx. Get ah=0 so we can compare.
si_prim_2:
mov al,es:[di] ;get the character.
cmp ax,dx ;are there actually that many?
jae si_prim_3 ;no - use the old character.
xlat ;get the new character.
si_prim_3:
stosb ;salt the character back to where we got it.
loop si_prim_2
si_prim_1:
dsdata
jmp return_tos
hk_prim:
;the hook primitive searches through a list of strings to execute.
;when it finds a string that exists, it drops through to gs_prim.
mov bp,0
hk_prim_1:
inc bp ;pre-increment
dsdata ;reload ds as part of loop.
mov cx,bp ;get the number of the form name arg.
call getarg ;get this argument
jcxz hk_prim_2 ;give up on the first null argument.
call find_string ;try to find it.
assume ds:formSeg
jc hk_prim_1 ;go if the function was not found.
dec bp
jmp short gs_prim_0
hk_prim_2:
jmp return_null
assume ds:data
;default primitive is the same as the cl primitive, only we start counting
; arguments from zero, not one.
dflt:
mov cx,0 ;get the number of the form name arg.
call find_arg
mov bp,-1
jnc gs_prim_0 ;go if the function was found.
mov si,offset dflta_name
mov cx,dflta_len ;try to find the default active function.
call make_active ;but first make it active.
je dflt_1 ;okay, it's really active.
mov si,offset dfltn_name
mov cx,dfltn_len ;Ahhhh, it *was* neutral - call dfltn first.
dflt_1:
call find_string
jc gs_prim_1 ;go if dflt isn't found.
jmp short gs_prim_0
gs_prim_1:
dsdata
jmp return_null
gs_prim:
call find_arg1
jc gs_prim_1 ;if it doesn't exist, return null.
mov bp,1
gs_prim_0:
assume ds:formSeg
jcxz gs_prim_1 ;if no characters, return null.
test formSeg:[bx].data_length,8000h ;does this have an sgap marker?
je gs_prim_6 ;no, there may be some...
;no sgaps, just return it literally.
di_points_fbgn
chk_room_cnt es ;check for collision
movmem ;move all the chars.
dsdata
jmp return_tos
gs_prim_6:
assume ds:formSeg
di_points_fend
gs_prim_2:
lodsb ;get char from form.
or al,al ;test it for sgapness
jge gs_prim_3 ;go if not sgap
sub al,sgap ;which sgap?
jz gs_prim_4 ;ignore sgap0's
cbw ;we're going to be counting off ax
add ax,bp ;add in the first arg number.
push ds ;preserve pointer, count of the form
push si
push cx
mov cx,ax
dsdata
call getarg
chk_room_cnt es
movmem
pop cx ;restore pointer, count of the form
pop si
pop ds
assume ds:formSeg
jmp gs_prim_4
gs_prim_3:
chk_room es
stosb
gs_prim_4:
loop gs_prim_2
dsdata
jmp return_tos
assume ds:data, es:data
go_prim:
call find_arg1
jc go_prim_1 ;form not found.
assume ds:formSeg
jcxz go_prim_2 ;no chars left.
di_points_fbgn
movsb ;no need to check for collision with actptr.
dec cx
jmp return_form
go_prim_2:
dsdata
mov cx,2
jmp return_arg_active
go_prim_1:
jmp return_null
assume ds:data, es:data
rs_prim:
call find_arg1
jc rs_prim_1
assume ds:formSeg
mov formSeg:[bx].form_pointer,0
dsdata
rs_prim_1:
jmp return_null
assume ds:data, es:data
gn_prim:
call find_arg1
jc gn_prim_1
assume ds:formSeg
jcxz gn_prim_2
push ds ;save pointer, count to form.
push si
push cx
push bx
dsdata
mov cx,2 ;get number of chars to call.
call get_decimal_arg
mov dx,ax ;save in dx.
pop bx
pop cx
pop si
pop ds
assume ds:formSeg
di_points_fbgn
cmp dx,cx ;are we trying to get more than exists?
jbe gn_prim_3 ;no - move the requested amount.
mov dx,cx ;yes - truncate the count.
gn_prim_3:
xchg dx,cx ;swap the count remaining and the get count.
sub dx,cx ;dec the count remaining by the get count.
chk_room_cnt es ;check for collision
movmem ;move all the chars.
mov cx,dx ;return the count remaining in cx.
jmp return_form
gn_prim_2:
dsdata
mov cx,3
jmp return_arg_active
gn_prim_1:
jmp return_null
assume ds:data, es:data
fm_prim:
call find_arg1
jc fm_prim_1 ;if form not found, return null.
assume ds:formSeg
jcxz fm_prim_2 ;if nothing to search, return two.
xchgdses
assume ds:data, es:formSeg
push si
mov di,si
mov dx,cx
mov cx,2
call getarg
;now si,cx => short string, di,dx => long string.
call string_search
jc fm_prim_3 ;if it's not found, just return arg 3.
;what we want to do now is to return the string from [tos] to [di],
; and advance the form pointer to point after the found string.
sub dx,cx ;dx gets long length - short length.
pop si
mov cx,di ;get the number of characters before
sub cx,si ; the search string.
xchgdses
assume ds:formSeg, es:data
di_points_fbgn ;prepare to return a string.
chk_room_cnt es ;make sure we have enough room.
movmem
mov cx,dx ;return_form expects the count in cx.
jmp return_form
fm_prim_3:
add sp,2 ;get rid of the pointer to the search string.
assume es:formSeg ;because of where we come from above.
esdata
mov cx,3
jmp return_arg_active
fm_prim_2:
assume ds:formSeg ;because of where we come from above.
dsdata
mov cx,3
jmp return_arg_active
fm_prim_1:
jmp return_null
assume ds:data, es:data
ev_prim:
xor si,si ;start at the beginning of the environ.
ev_prim_1:
mov di,fbgn
push si ;copy in the environ name.
mov si,offset environ_name
mov cx,environ_name_len
movmem
pop si
push ds
mov ds,phd_seg
mov ds,ds:[2ch]
ev_prim_2:
lodsb
stosb
or al,al
jne ev_prim_2
pop ds
mov cx,di ;compute the length of it.
sub cx,fbgn
dec cx ;don't count the null.
cmp cx,environ_name_len ;did we get any at all?
je ev_prim_3 ;if none, we're done.
push si ;remember the environment pointer.
mov di,fbgn ;make di->entire name.
mov si,di ;make si -> the name.
mov al,'=' ;look for the name/data separator.
repne scasb
mov dx,cx ;dx (data length) is number of chars left.
mov cx,di ;compute the name length.
sub cx,si
dec cx ;don't count the '='.
;define a form. Enter with:
; si => name
; cx = name length
; di => data
; dx = data length
; bx = form pointer.
xor bx,bx
call define_form
pop si
jmp ev_prim_1
ev_prim_3:
mov ah,30h ;get the dos version.
int 21h
cmp al,3 ;the full path is only in dos 3.0.
jb ev_prim_4
add si,2 ;point to the pathname.
mov di,fbgn
push ds
mov ds,phd_seg
mov ds,ds:[2ch]
ev_prim_5:
lodsb
stosb
or al,al
jne ev_prim_5
pop ds
mov dx,di ;compute the length of it.
sub dx,fbgn
dec dx ;don't count the null.
mov di,fbgn ;restore di again.
mov si,offset fullpath_name
mov cx,fullpath_len
xor bx,bx
call define_form
ev_prim_4:
mov di,fbgn
mov si,80h
push ds
mov ds,phd_seg
lodsb ;get the line length.
mov dl,al
mov dh,0
mov cx,dx ;put it where movs can destroy it.
movmem
pop ds
mov di,fbgn ;restore di again.
mov si,offset runline_name
mov cx,runline_len
xor bx,bx
call define_form
mov ax,3700h ;get the switchar.
int 21h
mov di,fbgn
mov [di],dl ;store the switchar.
mov dx,1 ;set the data length.
mov si,offset switchar_name
mov cx,switchar_len
xor bx,bx
call define_form
;define env.SCREEN to be the original screen.
mov dl,max_screen_line ;copy page one to active string.
add dl,2
mov cl,dl ;remember how many lines to do.
xor ch,ch
mov di,fbgn
ev_prim_6:
push cx
call read_chars
mov es:[di],LINENEW ;add a newline to the chars.
add di,2
inc dl
pop cx
loop ev_prim_6
mov dx,di
mov di,fbgn ;restore di again.
sub dx,di ;make dx = length of data.
mov si,offset screen_name
mov cx,screen_len
xor bx,bx
call define_form
jmp return_null
ret
ls_prim:
di_points_fend
call getarg1 ;get seperator and save it.
mov bp,si ;store the pointer to arg1 in bp
mov dx,cx ;store the size of arg1 in dx
mov cx,2 ;get the form prefix.
call getarg
mov form_prefix_len,cx
mov form_prefix_ptr,si
call first_form ;get a pointer to the first form.
;during the execution of this loop, bp->, dx = arg1, es:bx->forms.
ls_prim_1:
assume es:formSeg
je ls_prim_2 ;no more forms, we're done.
lea si,formSeg:[bx].name_offset ;get the name pointer.
mov cx,form_prefix_len
jcxz ls_prim_3 ;zero prefixes match anything.
cmp cx,formSeg:[bx].name_length ;is prefix length>name length?
ja ls_prim_4 ;yes - prefix can't match.
push di ;save the source pointers.
push si
mov di,si
mov si,form_prefix_ptr
repe cmpsb ;compare the prefix to the form name.
pop si
pop di
jne ls_prim_4 ;the prefixes didn't match - ignore it.
ls_prim_3:
mov cx,formSeg:[bx].name_length ;get the name length
xchgdses
assume ds:formSeg, es:data
chk_room_cnt es
movmem ;move the name in.
dsdata
mov si,bp ;get the pointer to arg1.
mov cx,dx ;get the size of arg1.
chk_room_cnt
movmem ;move it in.
ls_prim_4:
call next_form
jmp ls_prim_1 ;and continue.
ls_prim_2:
esdata
jmp return_tos
assume ds:data, es:data
es_prim:
mov si,fbgn ;point si at "es".
mov si,[si] ;point si at the first arg.
es_prim_1:
cmp si,[si] ;are we pointing at fend?
je es_prim_3
push si ;save pointer to args.
mov cx,[si] ;compute length of this arg.
sub cx,si
sub cx,mark_overhead
add si,mark_overhead-1 ;make si=> text of argument.
call find_form ;try to find this form.
jc es_prim_2 ;go if it didn't exist.
assume es:formSeg
call delete_form ;delete the form if it did exist.
esdata
es_prim_2:
pop si ;restore pointer to args.
mov si,[si] ;make it point to next arg.
jmp es_prim_1
es_prim_3:
jmp return_null
assume ds:data, es:data
sl_prim:
call getarg1_filename
mov dx,si
mov cx,0
mov ah,3ch ;create file.
int 21h
mov bx,ax ;remember the handle.
mov al,2
jc sl_prim_4
mov si,fbgn ;point si at the zeroth arg.
mov si,[si] ;point si at the form name.
mov si,[si] ;point si at the first search string.
sl_prim_1:
cmp si,[si] ;are we pointing at fend?
je sl_prim_3
push si ;save pointer to args.
mov cx,[si] ;compute length of this arg.
sub cx,si
sub cx,mark_overhead
add si,mark_overhead-1 ;make si=> text of argument.
push bx
call find_form
mov di,bx ;remember where the form is.
pop bx
jc sl_prim_2 ;go if it isn't there.
xchgdses
assume ds:formSeg, es:data
mov dx,di
mov cx,formSeg:[di].form_length
mov ah,40h ;write to a file
int 21h
dsdata
jnc sl_prim_2 ;no problem.
mov ah,3eh ;disk full - close the file.
int 21h
mov dx,offset filename ;delete the file.
mov ah,41h
int 21h
mov al,1
jmp short sl_prim_4
sl_prim_2:
pop si ;restore pointer to args.
mov si,[si] ;make it point to next arg.
esdata
jmp sl_prim_1
sl_prim_3:
mov ah,3eh ;close the file.
int 21h
mov al,0 ;no problem.
sl_prim_4:
mov bx,offset write_errors
jmp return_string
assume ds:data, es:data
ll_prim:
;Note that information about the structure 'form' is hard-coded into the
; next routine. We assume that 'form_length' is only two bytes long,
; and occurs at the beginning of the structure.
call getarg1_filename
mov dx,si
mov ax,3d00h ;open file for reading.
int 21h
mov bx,ax ;remember the handle.
mov al,2
jc ll_prim_4
mov cx,0 ;nothing in the buffer at present.
mov si,fend ;set the buffer pointer.
ll_prim_read:
;si -> buffer (=fend), cx = count left in buffer.
mov di,fend ;now move the rest of the buffer down
push cx ; to fend.
movmem
pop cx
mov si,fend ;now point to the rest of the buffer.
mov dx,di ;set disk transfer address.
push cx
mov cx,data_bottop ;add in the free space.
sub cx,di ;subtract off the buffer address.
mov ah,3fh ;read from a file.
int 21h
pop cx
jc ll_prim_5 ;close the file - trouble reading.
or ax,ax ;did we hit eof?
je ll_prim_6 ;yes - we're done.
add cx,ax ;add to the count the amount we read.
add dx,ax
mov data_topbot,dx ;remember the highest location that we use.
cmp cx,[si] ;do we have enough room to read this in?
jb ll_prim_3 ;no - report nomem.
ll_prim_1:
;si -> buffer, cx = count left in buffer.
cmp word ptr [si],0 ;is this the end of the library?
je ll_prim_6 ;yes - we're all done.
push bx ;define this form.
push cx
push si
mov cx,[si].name_length
mov dx,[si].data_length
mov bx,[si].form_pointer
lea si,[si].name_offset
mov di,si
add di,cx ;or [si].name_length, but cx is cheaper.
call define_form
pop si
pop cx
pop bx
sub cx,[si] ;remove this one from the buffer.
add si,[si] ;skip past this one.
cmp cx,2 ;if not enough, we need to read again.
jb ll_prim_read
cmp cx,[si] ;do we have that many bytes?
jb ll_prim_read ;if not enough, we need to read again.
jmp ll_prim_1
ll_prim_6:
mov ah,3eh ;close the file.
int 21h
mov al,0 ;all ok.
jmp ll_prim_4 ;we destroyed the active string.
ll_prim_3:
mov ah,3eh ;close the file.
int 21h
call nomem
ll_prim_5:
mov ah,3eh ;close the file.
int 21h
mov al,3 ;read error.
ll_prim_4:
mov bx,offset read_errors
jmp return_string
ad_prim:
call get_math
add ax,bx
jmp return_number_si
su_prim:
call get_math
sub ax,bx
jmp return_number_si
ml_prim:
call get_math
imul bx
jmp return_number_si
dv_prim:
call get_math
or bx,bx
je dv_prim_1
cwd
idiv bx
dv_prim_1:
jmp return_number_si
md_prim:
call get_math
or bx,bx
je md_prim_1
cwd
idiv bx
mov ax,dx
md_prim_1:
jmp return_number_si
and_prim:
call get_math
and ax,bx
jmp return_number_si
or_prim:
call get_math
or ax,bx
jmp return_number_si
xor_prim:
call get_math
xor ax,bx
jmp return_number_si
gr_prim:
call get_math
mov cx,3
cmp ax,bx
jg gr_prim_1
mov cx,4
gr_prim_1:
jmp return_arg
st_prim:
;set the syntax table.
call find_arg1
assume ds:formSeg
jnc st_prim_1
mov bx,NIL ;if form not found, use NIL.
st_prim_1:
call store_syntax_table
dsdata
jmp return_null
;primitive declarations
public st_prim
public dflt
public hl_prim
public eq_prim
public ne_prim
public nc_prim
public db_prim
public ct_prim
;forms
public ds_prim
public mp_prim
public gs_prim
public hk_prim
public go_prim
public gn_prim
public rs_prim
public fm_prim
public ev_prim
public ls_prim
public es_prim
public sl_prim
public ll_prim
public nb_prim
public si_prim
;math
public ad_prim
public su_prim
public ml_prim
public dv_prim
public md_prim
public and_prim
public or_prim
public xor_prim
public gr_prim
;form subroutines
extrn define_form: near
extrn delete_form: near
;delete_form deletes the form pointed to by ds:bx.
;store_syntax_table stores the form in es:bx as the syntax table.
extrn store_syntax_table: near
extrn first_form: near ;returns es:bx ->first form.
extrn next_form: near ;returns es:bx ->next form, zr if none.
extrn find_form: near
;find_form returns bx pointing to the form whose name is pointed to by si.
; The length of the form name is given in cx.
; If the form doesn't exist, cy is set, otherwise cy is clear.
; A pointer to the form header is returned in es:bx
extrn find_arg1: near
;find_arg1 returns bx pointing to the form whose name is given in
; arg1. If the form doesn't exist, cy is set, otherwise cy is clear.
; ds:si points to the form data after the form pointer, and cx is the
; number of chars after the form pointer.
extrn find_arg: near
;find_arg returns bx pointing to the form whose name is given in
; the arg specified by cx. If the form doesn't exist, cy is
; set, otherwise cy is clear. ds:si points to the form data
; after the form pointer, and cx is the number of chars after
; the form pointer.
extrn find_string: near
;find_string returns bx pointing to the form whose name is specified by si,cx.
; If the form doesn't exist, cy is set, otherwise cy is clear. ds:si
; points to the form data after the form pointer, and cx is the number
; of chars after the form pointer.
;utility subroutines
public get_math
get_math:
;exit with ax=first number, bx=second number, si->first arg, di->first number.
mov cx,2
call get_decimal_arg
push ax
call getarg1
push si
call get_decimal
mov di,si
pop si
pop bx ;pushed as ax
ret
public get_decimal_arg1
get_decimal_arg1:
mov cx,1
;fall through
public get_decimal_arg
get_decimal_arg:
call getarg
;fall through
public get_decimal
get_decimal:
mov bx,10
;fall through
public get_number
get_number:
;enter with si,cx => string containing trailing number, bx=base to convert
; number in. Return number in ax, si => start of digit string.
add si,cx
push cx
get_number_1:
dec si
mov al,[si]
sub al,"0" ;between 0 and "9"?
jb get_number_2 ;no - can't be a digit.
cmp al,"9"-"0" ;between "0" and "9"?
jbe get_number_6 ;yes - must be a digit.
cmp al,"a"-"0"
jb get_number_8
sub al,"a"-"A"
get_number_8:
cmp al,"A"-"0" ;between "A" and "9"?
jb get_number_2 ;yes - can't be a digit.
sub al,"A"-("0"+10) ;convert "A" to 10
get_number_6:
cmp al,bl ;a legal digit in the desired base?
jae get_number_2 ;no.
loop get_number_1
dec si ;setup for pre-increment.
get_number_2:
mov dx,cx
pop cx ;restore count.
sub cx,dx ;get the actual count of chars into cx.
push dx ;remember the number of characters left.
inc si
push si ;save a copy of the start of the number.
mov ax,0 ;initially zero.
;at this point, si => first digit, cx = count of digits to convert.
jcxz get_number_4 ;if no more chars, we're done.
get_number_3:
mul bx
mov dx,ax
lodsb ;ax = new ASCII digit.
sub al,"0" ;make it a number.
cmp al,"9"-"0"
jbe get_number_7
cmp al,"a"-"0"
jb get_number_9
sub al,"a"-"A"
get_number_9:
sub al,"A"-("0"+10)
get_number_7:
cbw ;make it a word.
add ax,dx ;and add in the old value.
loop get_number_3
get_number_4:
pop si
pop dx
or dx,dx ;did we use up all the characters?
je get_number_5 ;yes - don't look for a minus sign.
cmp byte ptr -1[si],"-"
jne get_number_5
dec si
neg ax
get_number_5:
ret
return_number_si:
push si
public return_number
return_number:
;enter with di => place to put string, tos => start of string,
; ax=number.
mov cx,0 ;use only as many digits as is needed.
mov bx,10
call put_number
jmp return_tos
public put_number
put_number:
;enter with di => place to put string, ax = number, cx=minimum number of digits
; bx=base to convert number to.
or ax,ax
jge put_number_1
neg ax
mov byte ptr [di],"-"
inc di
put_number_1:
call one_digit
ret
one_digit:
jcxz one_digit_3
dec cx
one_digit_3:
xor dx,dx ;unsigned number.
div bx
push dx
or ax,ax
jnz one_digit_1 ;if more digits, do them.
jcxz one_digit_2 ;if count is zero, don't do next digit.
;we get here if we have more digits to do, or we have more leading
; zeroes to place.
one_digit_1:
call one_digit
one_digit_2:
pop ax ;pushed as dx
add al,"0"
cmp al,"9"
jbe one_digit_4
add al,"A"-("9"+1) ;the digit above "9" becomes an "A".
one_digit_4:
chk_room
stosb
ret
string_search:
if 0
;enter with si,cx => short string, es:di,dx => long string.
;exit with nc if string was found, es:di,dx => position found.
;exit with cy if string was not found.
jcxz string_search_3 ;zero length strings are found immediately
;we can get into trouble if cx = 0 after this point.
string_search_1:
cmp dx,cx
jb string_search_2
push si ;preserve all the registers.
push di
push cx
repe cmpsb
pop cx
pop di
pop si
je string_search_3
dec dx
inc di
jmp string_search_1
string_search_3:
clc
ret
string_search_2:
stc
ret
else
;enter with si,cx => short string, es:di,dx => long string.
;exit with nc if string was found, es:di,dx => position found.
;exit with cy if string was not found.
;preserve si,cx, ah.
push bx
jcxz string_search_3 ;zero length strings are found immediately
mov bx,cx ;save short string length.
mov cx,dx ;get long string length.
mov dx,si ;save short string pointer.
dec bx
sub cx,bx ;this many fewer chars to look at.
jb string_search_2 ;"short" string isn't really shorter.
string_search_1:
jcxz string_search_2 ;no chars to look at.
mov si,dx
lodsb ;get the first char.
repne scasb ;look for the first char.
jnz string_search_2 ;we didn't find it.
push cx ;save the short length length
push di ;save the long position
mov cx,bx ;get cx=short string length - 1.
or cx,cx ;if cx is zero, we match.
repe cmpsb ;is this it?
pop di ;restore the long position
pop cx ;restore the short length
jne string_search_1 ;no match - try at next position.
mov si,dx ;restore short pointer.
dec di ;make di point to the first char again.
inc cx ;and have cx be the number of chars left.
add cx,bx ;restore the original count.
mov dx,cx ;return the remaining count in dx.
mov cx,bx ;restore short count
inc cx ;restore count's original value.
string_search_3:
pop bx
clc
ret
string_search_2:
mov si,dx ;restore short pointer.
mov cx,bx ;restore search count
inc cx ;restore count's original value.
pop bx
stc
ret
endif
public getarg1_filename
getarg1_filename:
mov cx,1
public getarg_filename
getarg_filename:
;return si ->filename, zr if filename is null.
call getarg
mov di,offset filename
movmem
xor al,al
stosb
mov si,offset filename
cmp [si],al
ret
extrn getarg1: near
;getarg1 returns si -> the first argument. cx is set to the size
; of the first argument.
extrn getarg: near
;getarg returns si -> the argument given in cx. cx is set to the size
; of the argument.
code ends
end init
